library(tidyverse)
library(plotly)
library(sf)
library(mapview)
library(tigris)
library(censusapi)
library(leaflet)
library(lehdr)
library(usmap)
options(
tigris_class = "sf",
tigris_use_cache = TRUE
)
Sys.setenv(CENSUS_KEY="10dcd73d7c043e91bac9fb8d3989cbff54b08790")
# load in income data - code adapted from other students
bay_median_income_by_block <-
pullCensus("B19013_001E", bay_area_counties) %>%
filter(blockgroup %in% bay_sd$origin_census_block_group) %>%
rename(
Median_Income = B19013_001E
) %>%
filter(!is.na(Median_Income)) %>%
left_join(bay_sd_at_home_average, by = c("blockgroup" = "origin_census_block_group")) %>%
filter(!is.na(device_count))
bay_ami_by_block <-
pullCensus("group(B19001)", bay_area_counties) %>%
dplyr::select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
filter(blockgroup %in% bay_sd$origin_census_block_group) %>%
group_by(blockgroup) %>%
summarize(
Total = B19001_001E,
`Under 75,000` = sum(B19001_002E, B19001_003E, B19001_004E, B19001_005E, B19001_006E, B19001_007E, B19001_008E, B19001_009E, B19001_010E, B19001_011E, B19001_012E),
#sum(lapply(2:12, function(x) as.name(paste0("B19001_00",x,"E"))))
`Under 100,000` = sum(B19001_002E, B19001_003E, B19001_004E, B19001_005E, B19001_006E, B19001_007E, B19001_008E, B19001_009E, B19001_010E, B19001_011E, B19001_012E, B19001_013E),
`Under 125,000` = sum(B19001_002E, B19001_003E, B19001_004E, B19001_005E, B19001_006E, B19001_007E, B19001_008E, B19001_009E, B19001_010E, B19001_011E, B19001_012E, B19001_013E, B19001_014E),
`Under 150,000` = sum(B19001_002E, B19001_003E, B19001_004E, B19001_005E, B19001_006E, B19001_007E, B19001_008E, B19001_009E, B19001_010E, B19001_011E, B19001_012E, B19001_013E, B19001_014E, B19001_015E)
) %>%
mutate(
`% under 75,000` = `Under 75,000` / Total * 100,
`% over 75,000` = (100 - `% under 75,000`),
`% under 100,000` = `Under 100,000` / Total * 100,
`% over 100,000` = (100 - `% under 100,000`),
`% under 125,000` = `Under 125,000` / Total * 100,
`% over 125,000` = (100 - `% under 125,000`),
`% under 150,000` = `Under 150,000` / Total * 100,
`% over 150,000` = (100 - `% under 150,000`),
) %>%
left_join(bay_median_income_by_block %>% dplyr::select(-Median_Income)
) %>%
filter(!is.na(device_count))
# plotting
bay_ami_by_block %>%
ggplot(aes(
x = `% over 75,000`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $75,000 annually",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Households Above $75,000"
)
income_75_model <- lm(`% Not Completely at Home` ~ `% over 75,000`, bay_ami_by_block)
summary(income_75_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% over 75,000`, data = bay_ami_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -24.950 -5.481 -0.589 5.004 42.475
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 62.80723 0.40400 155.46 <2e-16 ***
## `% over 75,000` -0.15283 0.00635 -24.07 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.439 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.1091, Adjusted R-squared: 0.1089
## F-statistic: 579.2 on 1 and 4728 DF, p-value: < 2.2e-16
# income - less than $100000
bay_ami_by_block %>%
ggplot(aes(
x = `% over 100,000`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $100,000 annually",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Households Above $100,000"
)
income_100_model <- lm(`% Not Completely at Home` ~ `% over 100,000`, bay_ami_by_block)
summary(income_100_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% over 100,000`, data = bay_ami_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -23.841 -5.502 -0.610 4.829 44.423
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 61.223085 0.312190 196.11 <2e-16 ***
## `% over 100,000` -0.156457 0.005862 -26.69 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.335 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.131, Adjusted R-squared: 0.1308
## F-statistic: 712.5 on 1 and 4728 DF, p-value: < 2.2e-16
# income - less than $125000
bay_ami_by_block %>%
ggplot(aes(
x = `% over 125,000`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $125,000 annually",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Households Above $125,000"
)
income_125_model <- lm(`% Not Completely at Home` ~ `% over 125,000`, bay_ami_by_block)
summary(income_125_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% over 125,000`, data = bay_ami_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -25.857 -5.389 -0.552 4.719 46.493
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 60.027700 0.259526 231.3 <2e-16 ***
## `% over 125,000` -0.165202 0.005859 -28.2 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.272 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.1439, Adjusted R-squared: 0.1438
## F-statistic: 795 on 1 and 4728 DF, p-value: < 2.2e-16
# income - less than $150000
bay_ami_by_block %>%
ggplot(aes(
x = `% over 150,000`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $150,000 annually",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Households Above $150,000"
)
income_150_model <- lm(`% Not Completely at Home` ~ `% over 150,000`, bay_ami_by_block)
summary(income_150_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% over 150,000`, data = bay_ami_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -28.271 -5.437 -0.574 4.741 44.959
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 58.891344 0.226982 259.5 <2e-16 ***
## `% over 150,000` -0.171093 0.006154 -27.8 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.289 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.1405, Adjusted R-squared: 0.1403
## F-statistic: 773 on 1 and 4728 DF, p-value: < 2.2e-16
Compare to pre-shelter-in-place behavior:
bay_ami_by_block %>%
ggplot(aes(
x = `% over 75,000`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $75,000 annually",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Households Above $75,000 Pre Shelter-in-Place"
)
income_75_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `% over 75,000`, bay_ami_by_block)
summary(income_75_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% over 75,000`,
## data = bay_ami_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -30.095 -2.942 0.245 3.290 20.435
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 70.965396 0.239540 296.26 <2e-16 ***
## `% over 75,000` 0.113036 0.003765 30.02 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.003 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.1601, Adjusted R-squared: 0.1599
## F-statistic: 901.3 on 1 and 4728 DF, p-value: < 2.2e-16
# income - less than $100000
bay_ami_by_block %>%
ggplot(aes(
x = `% over 100,000`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $100,000 annually",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Households Above $100,000 Pre Shelter-in-Place"
)
income_100_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `% over 100,000`, bay_ami_by_block)
summary(income_100_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% over 100,000`,
## data = bay_ami_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -30.2334 -2.9109 0.3057 3.3078 18.9262
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 72.473764 0.186304 389.01 <2e-16 ***
## `% over 100,000` 0.108863 0.003498 31.12 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.974 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.17, Adjusted R-squared: 0.1699
## F-statistic: 968.6 on 1 and 4728 DF, p-value: < 2.2e-16
# income - less than $125000
bay_ami_by_block %>%
ggplot(aes(
x = `% over 125,000`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $125,000 annually",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Social Distancing and Households Above $125,000 Pre Shelter-in-Place"
)
income_125_model <- lm(`% Not Completely at Home Pre Shelter` ~ `% over 125,000`, bay_ami_by_block)
summary(income_125_model)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% over 125,000`,
## data = bay_ami_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.3512 -2.8027 0.3572 3.2505 17.9572
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 73.442753 0.155512 472.26 <2e-16 ***
## `% over 125,000` 0.111451 0.003511 31.74 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.957 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.1757, Adjusted R-squared: 0.1755
## F-statistic: 1008 on 1 and 4728 DF, p-value: < 2.2e-16
# income - less than $150000
bay_ami_by_block %>%
ggplot(aes(
x = `% over 150,000`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $150,000 annually",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Social Distancing and Households Above $150,000 Pre Shelter-in-Place"
)
income_150_model <- lm(`% Not Completely at Home Pre Shelter` ~ `% over 150,000`, bay_ami_by_block)
summary(income_150_model)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% over 150,000`,
## data = bay_ami_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -32.373 -2.878 0.360 3.302 17.222
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 74.178083 0.135838 546.08 <2e-16 ***
## `% over 150,000` 0.116426 0.003683 31.61 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.96 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.1745, Adjusted R-squared: 0.1743
## F-statistic: 999.5 on 1 and 4728 DF, p-value: < 2.2e-16
# loading in language data - code adapted from other students
bay_lang_by_block <-
pullCensus("group(B16004)", bay_area_counties) %>%
select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
gather(
key = "variable",
value = "estimate",
- blockgroup
) %>%
left_join(acs_vars, by = c("variable" = "name")) %>%
mutate(
tier = substr(label,lapply(label, function(x) max(unlist(gregexpr('!!',x)))+2),nchar(label))
) %>%
filter(tier %in% c('Speak English "not well"',
'Speak English "not at all"',
'Total', 'Speak Spanish',
'Speak Asian and Pacific Island languages')) %>%
group_by(blockgroup, tier) %>%
summarise(
estimate1 = sum(estimate)
) %>%
spread(
key = "tier",
value = "estimate1"
) %>%
mutate(
`% speaking english < well` = (`Speak English "not well"` + `Speak English "not at all"`) / Total * 100,
`% speaking english > well` = (100 - `% speaking english < well`),
`% speaking spanish` = (`Speak Spanish`/ Total) * 100,
`% not speaking spanish` = (100 - `% speaking spanish`),
`% speaking api` = (`Speak Asian and Pacific Island languages` / Total) * 100
) %>%
left_join(bay_median_income_by_block %>% dplyr::select(-Median_Income)) %>%
filter(!is.na(device_count)) %>%
mutate(log_perc = log(`% speaking english < well`))
# plotting
bay_lang_by_block %>%
ggplot(aes(
x = `% speaking english > well`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of individuals speaking English well",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and English Language Ability"
)
english_ability_model <- lm(`% Not Completely at Home` ~ `% speaking english > well`, bay_lang_by_block)
summary(english_ability_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% speaking english > well`,
## data = bay_lang_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -29.050 -5.829 -0.300 5.478 40.573
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 54.24165 1.42632 38.029 <2e-16 ***
## `% speaking english > well` -0.00720 0.01538 -0.468 0.64
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.989 on 4734 degrees of freedom
## (7 observations deleted due to missingness)
## Multiple R-squared: 4.626e-05, Adjusted R-squared: -0.000165
## F-statistic: 0.219 on 1 and 4734 DF, p-value: 0.6398
bay_lang_by_block %>%
ggplot(aes(
x = `% not speaking spanish`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of individuals not speaking Spanish",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Spanish Language Ability"
)
spanish_speaking_model <- lm(`% Not Completely at Home` ~ `% not speaking spanish`, bay_lang_by_block)
summary(spanish_speaking_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% not speaking spanish`,
## data = bay_lang_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -28.789 -5.682 -0.491 5.102 41.431
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 63.688477 0.622427 102.32 <2e-16 ***
## `% not speaking spanish` -0.120385 0.007255 -16.59 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.739 on 4734 degrees of freedom
## (7 observations deleted due to missingness)
## Multiple R-squared: 0.05497, Adjusted R-squared: 0.05477
## F-statistic: 275.4 on 1 and 4734 DF, p-value: < 2.2e-16
Compare to pre-shelter-in-place behavior:
bay_lang_by_block %>%
ggplot(aes(
x = `% speaking english > well`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of individuals speaking English well",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and English Language Ability Pre Shelter-in-Place"
)
english_ability_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `% speaking english > well`, bay_lang_by_block)
summary(english_ability_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% speaking english > well`,
## data = bay_lang_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -33.866 -3.136 0.362 3.676 14.914
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 61.829284 0.837774 73.80 <2e-16 ***
## `% speaking english > well` 0.173148 0.009037 19.16 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.279 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.07199, Adjusted R-squared: 0.0718
## F-statistic: 367.1 on 1 and 4732 DF, p-value: < 2.2e-16
bay_lang_by_block %>%
ggplot(aes(
x = `% not speaking spanish`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of individuals not speaking Spanish",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Spanish Language Ability Pre Shelter-in-Place"
)
spanish_speaking_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `% not speaking spanish`, bay_lang_by_block)
summary(spanish_speaking_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% not speaking spanish`,
## data = bay_lang_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -32.848 -3.159 0.413 3.603 13.869
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 70.818907 0.376268 188.21 <2e-16 ***
## `% not speaking spanish` 0.083275 0.004386 18.99 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.283 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.0708, Adjusted R-squared: 0.07061
## F-statistic: 360.6 on 1 and 4732 DF, p-value: < 2.2e-16
# loading in age data - specifically looking at percentage 65+ and percentage <30
bay_age_by_block <-
pullCensus("group(B01001)", bay_area_counties) %>%
select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
gather(
key = "variable",
value = "estimate",
- blockgroup
) %>%
mutate(
label = acs_vars$label[match(variable,acs_vars$name)]
) %>%
select(-variable) %>%
separate(
label,
into = c(NA,NA,"sex","age"),
sep = "!!"
) %>% filter(!is.na(age)) %>%
mutate(elderly = ifelse(age %in% c("65 and 66 years", "67 to 69 years", "70 to 74 years", "75 to 79 years", "80 to 84 years", "85 years and over"), estimate, NA), `less than 30` = ifelse(age %in% c("Under 5 years", "5 to 9 years", "10 to 14 years", "15 to 17 years", "18 and 19 years", "20 years", "21 years", "22 to 24 years", "25 to 29 years"), estimate, NA), `less than 18` = ifelse(age %in% c("Under 5 years", "5 to 9 years", "10 to 14 years", "15 to 17 years"), estimate, NA), `20-29` = ifelse(age %in% c("20 years", "21 years", "22 to 24 years", "25 to 29 years"), estimate, NA)) %>%
group_by(blockgroup) %>%
summarize(elderly = sum(elderly, na.rm = T), `less than 30` = sum(`less than 30`, na.rm = T), total = sum(estimate, na.rm = T), `less than 18` = sum(`less than 18`, na.rm = T), `20-29` = sum(`20-29`, na.rm = T)) %>%
mutate(`percent elderly` = elderly*100 / total, `percent less than 30` = `less than 30`*100 / total, `percent nonelderly` = (100 - `percent elderly`), `percent less than 18` = `less than 18`*100/total, `percent 20-29` = `20-29`*100/total) %>%
left_join(bay_median_income_by_block %>% dplyr::select(-Median_Income)) %>%
filter(!is.na(device_count))
# plotting
bay_age_by_block %>%
ggplot(aes(
x = `percent less than 30`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents younger than 30",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Young Age Groups"
)
young_model <- lm(bay_age_by_block$`% Not Completely at Home` ~ bay_age_by_block$`percent less than 30`)
summary(young_model)
##
## Call:
## lm(formula = bay_age_by_block$`% Not Completely at Home` ~ bay_age_by_block$`percent less than 30`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -30.612 -5.685 -0.324 5.298 37.581
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 49.21355 0.45666 107.769 <2e-16
## bay_age_by_block$`percent less than 30` 0.12308 0.01235 9.963 <2e-16
##
## (Intercept) ***
## bay_age_by_block$`percent less than 30` ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.897 on 4734 degrees of freedom
## (7 observations deleted due to missingness)
## Multiple R-squared: 0.02054, Adjusted R-squared: 0.02033
## F-statistic: 99.26 on 1 and 4734 DF, p-value: < 2.2e-16
bay_age_by_block %>% filter(`percent elderly` < 50) %>% # get rid of extreme outliers
ggplot(aes(
x = `percent elderly`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents 65 and older",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Elderly Population"
)
elderly_model <- lm(`% Not Completely at Home` ~ `percent elderly`, bay_age_by_block %>% filter(`percent elderly` < 50))
summary(elderly_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `percent elderly`,
## data = bay_age_by_block %>% filter(`percent elderly` < 50))
##
## Residuals:
## Min 1Q Median 3Q Max
## -29.740 -5.773 -0.321 5.499 39.732
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 54.40160 0.27777 195.853 < 2e-16 ***
## `percent elderly` -0.05656 0.01604 -3.527 0.000425 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.957 on 4693 degrees of freedom
## Multiple R-squared: 0.002643, Adjusted R-squared: 0.002431
## F-statistic: 12.44 on 1 and 4693 DF, p-value: 0.0004248
bay_age_by_block %>%
ggplot(aes(
x = `percent 20-29`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents ages 20-29",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Young Adults"
)
young_adult_model <- lm(bay_age_by_block$`% Not Completely at Home` ~ bay_age_by_block$`percent 20-29`)
summary(young_adult_model)
##
## Call:
## lm(formula = bay_age_by_block$`% Not Completely at Home` ~ bay_age_by_block$`percent 20-29`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -29.331 -5.759 -0.354 5.323 41.888
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 50.75100 0.24379 208.17 <2e-16 ***
## bay_age_by_block$`percent 20-29` 0.21104 0.01549 13.63 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.818 on 4734 degrees of freedom
## (7 observations deleted due to missingness)
## Multiple R-squared: 0.03774, Adjusted R-squared: 0.03753
## F-statistic: 185.7 on 1 and 4734 DF, p-value: < 2.2e-16
bay_age_by_block %>%
ggplot(aes(
x = `percent less than 18`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents younger than 18",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Children"
)
child_model <- lm(bay_age_by_block$`% Not Completely at Home` ~ bay_age_by_block$`percent less than 18`)
summary(child_model)
##
## Call:
## lm(formula = bay_age_by_block$`% Not Completely at Home` ~ bay_age_by_block$`percent less than 18`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -27.559 -5.915 -0.364 5.577 44.592
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 56.19993 0.34997 160.59 < 2e-16
## bay_age_by_block$`percent less than 18` -0.13057 0.01618 -8.07 8.85e-16
##
## (Intercept) ***
## bay_age_by_block$`percent less than 18` ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.928 on 4734 degrees of freedom
## (7 observations deleted due to missingness)
## Multiple R-squared: 0.01357, Adjusted R-squared: 0.01336
## F-statistic: 65.12 on 1 and 4734 DF, p-value: 8.847e-16
Compare to pre-shelter-in-place behavior:
bay_age_by_block %>%
ggplot(aes(
x = `percent less than 30`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents younger than 30",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Young Age Groups Pre Shelter-in-Place"
)
young_model2 <- lm(bay_age_by_block$`% Not Completely at Home Pre Shelter` ~ bay_age_by_block$`percent less than 30`)
summary(young_model2)
##
## Call:
## lm(formula = bay_age_by_block$`% Not Completely at Home Pre Shelter` ~
## bay_age_by_block$`percent less than 30`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -33.649 -3.332 0.283 3.749 15.296
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 78.773529 0.281877 279.460 < 2e-16
## bay_age_by_block$`percent less than 30` -0.027096 0.007631 -3.551 0.000388
##
## (Intercept) ***
## bay_age_by_block$`percent less than 30` ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.473 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.002657, Adjusted R-squared: 0.002447
## F-statistic: 12.61 on 1 and 4732 DF, p-value: 0.0003878
bay_age_by_block %>% filter(`percent elderly` < 50) %>% # get rid of extreme outliers
ggplot(aes(
x = `percent elderly`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents 65 and older",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Elderly Population Pre Shelter-in-Place"
)
elderly_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `percent elderly`, bay_age_by_block %>% filter(`percent elderly` < 50))
summary(elderly_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `percent elderly`,
## data = bay_age_by_block %>% filter(`percent elderly` < 50))
##
## Residuals:
## Min 1Q Median 3Q Max
## -32.714 -3.316 0.331 3.681 14.810
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 76.546794 0.167597 456.730 <2e-16 ***
## `percent elderly` 0.085606 0.009675 8.848 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.399 on 4691 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.01642, Adjusted R-squared: 0.01621
## F-statistic: 78.29 on 1 and 4691 DF, p-value: < 2.2e-16
bay_age_by_block %>%
ggplot(aes(
x = `percent 20-29`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents 20-29",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Young Adults Pre Shelter-in-Place"
)
young_adult_model2 <- lm(bay_age_by_block$`% Not Completely at Home Pre Shelter` ~ bay_age_by_block$`percent 20-29`)
summary(young_adult_model2)
##
## Call:
## lm(formula = bay_age_by_block$`% Not Completely at Home Pre Shelter` ~
## bay_age_by_block$`percent 20-29`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -32.861 -3.283 0.271 3.622 19.281
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 79.612651 0.149249 533.42 <2e-16 ***
## bay_age_by_block$`percent 20-29` -0.134571 0.009516 -14.14 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.368 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.04055, Adjusted R-squared: 0.04035
## F-statistic: 200 on 1 and 4732 DF, p-value: < 2.2e-16
bay_age_by_block %>%
ggplot(aes(
x = `percent less than 18`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents younger than 18",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Children Pre Shelter-in-Place"
)
child_model2 <- lm(bay_age_by_block$`% Not Completely at Home Pre Shelter` ~ bay_age_by_block$`percent less than 18`)
summary(child_model2)
##
## Call:
## lm(formula = bay_age_by_block$`% Not Completely at Home Pre Shelter` ~
## bay_age_by_block$`percent less than 18`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.5690 -3.3708 0.3005 3.7710 15.4110
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 76.269015 0.213768 356.783 < 2e-16
## bay_age_by_block$`percent less than 18` 0.076842 0.009881 7.777 9.06e-15
##
## (Intercept) ***
## bay_age_by_block$`percent less than 18` ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.446 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.01262, Adjusted R-squared: 0.01241
## F-statistic: 60.48 on 1 and 4732 DF, p-value: 9.058e-15
# also get data on vehicles available as households without a vehicle
bay_no_vehicles_by_block <- pullCensus("group(B25044)", bay_area_counties) %>%
select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
gather(key = "variable", value = "estimate", -blockgroup) %>%
mutate(label = acs_vars$label[match(variable,acs_vars$name)]) %>%
select(-variable) %>%
separate(label, into = c(NA, NA, NA,"vehicles"), sep = "!!") %>%
filter(!is.na(vehicles)) %>%
group_by(blockgroup, vehicles) %>%
summarize(grouped_vehicles = sum(estimate)) %>%
spread(key = vehicles, value = grouped_vehicles) %>%
mutate(total_nums = `1 vehicle available` + `2 vehicles available` + `3 vehicles available` + `4 vehicles available` + `5 or more vehicles available` + `No vehicle available`, `percent no vehicles` = `No vehicle available`*100 / total_nums, `percent with vehicles` = (100-`percent no vehicles`)) %>%
left_join(bay_age_by_block %>% dplyr::select_if(!names(.) %in% c("elderly", "percent elderly", "less than 30", "percent less than 30"))) %>%
filter(!is.na(device_count))
# plotting
bay_no_vehicles_by_block %>%
ggplot(aes(
x = `percent with vehicles`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with vehicles available",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Vehicle Availability"
)
vehicles_model <- lm(`% Not Completely at Home` ~ `percent with vehicles`, bay_no_vehicles_by_block)
summary(vehicles_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `percent with vehicles`,
## data = bay_no_vehicles_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -28.719 -5.880 -0.278 5.498 40.680
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 57.07017 0.95913 59.502 < 2e-16 ***
## `percent with vehicles` -0.03851 0.01038 -3.711 0.000209 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.928 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.002904, Adjusted R-squared: 0.002693
## F-statistic: 13.77 on 1 and 4728 DF, p-value: 0.0002088
Compare to pre-shelter-in-place behavior:
bay_no_vehicles_by_block %>%
ggplot(aes(
x = `percent with vehicles`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with vehicles available",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Vehicle Availability Pre Shelter-in-Place"
)
vehicles_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `percent with vehicles`, bay_no_vehicles_by_block)
summary(vehicles_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `percent with vehicles`,
## data = bay_no_vehicles_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -30.3199 -3.2767 0.2145 3.5354 22.1954
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 66.925407 0.564331 118.59 <2e-16 ***
## `percent with vehicles` 0.118945 0.006106 19.48 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.253 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.07429, Adjusted R-squared: 0.0741
## F-statistic: 379.5 on 1 and 4728 DF, p-value: < 2.2e-16
# get data on occupants per room
bay_occupants_per_room_by_block <- pullCensus("group(B25014)", bay_area_counties) %>%
select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
gather(key = "variable", value = "estimate", -blockgroup) %>%
mutate(label = acs_vars$label[match(variable,acs_vars$name)]) %>%
select(-variable) %>%
separate(label, into = c(NA, NA, NA,"occupants per room"), sep = "!!") %>%
filter(!is.na(`occupants per room`)) %>%
group_by(blockgroup, `occupants per room`) %>%
summarize(estimate_tot = sum(estimate)) %>%
spread(key = `occupants per room`, value = estimate_tot) %>%
mutate(total_nums = `0.50 or less occupants per room` + `0.51 to 1.00 occupants per room` + `1.01 to 1.50 occupants per room` + `1.51 to 2.00 occupants per room` + `2.01 or more occupants per room`, `percent 1 or more` = (`1.01 to 1.50 occupants per room` + `1.51 to 2.00 occupants per room` + `2.01 or more occupants per room`) * 100/ total_nums, `percent less than 1` = (100-`percent 1 or more`)) %>%
left_join(bay_age_by_block %>% dplyr::select_if(!names(.) %in% c("elderly", "percent elderly", "less than 30", "percent less than 30"))) %>%
filter(!is.na(device_count))
# plotting
bay_occupants_per_room_by_block %>%
ggplot(aes(
x = `percent less than 1`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of households with 1 or fewer occupant per room",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Room Occupancy"
)
occupants_model <- lm(`% Not Completely at Home` ~ `percent less than 1`, bay_occupants_per_room_by_block)
summary(occupants_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `percent less than 1`,
## data = bay_occupants_per_room_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -28.441 -5.713 -0.341 5.429 40.742
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 61.92498 1.41735 43.691 < 2e-16 ***
## `percent less than 1` -0.08984 0.01513 -5.938 3.09e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.908 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.007403, Adjusted R-squared: 0.007193
## F-statistic: 35.26 on 1 and 4728 DF, p-value: 3.087e-09
Compare to pre-shelter-in-place behavior:
bay_occupants_per_room_by_block %>%
ggplot(aes(
x = `percent less than 1`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of households with 1 or fewer occupant per room",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Room Occupancy Pre Shelter-in-Place"
)
occupants_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `percent less than 1`, bay_occupants_per_room_by_block)
summary(occupants_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `percent less than 1`,
## data = bay_occupants_per_room_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -30.361 -3.161 0.316 3.671 17.116
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 63.306072 0.842479 75.14 <2e-16 ***
## `percent less than 1` 0.155550 0.008993 17.30 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.295 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.05951, Adjusted R-squared: 0.05931
## F-statistic: 299.2 on 1 and 4728 DF, p-value: < 2.2e-16
bay_education_by_block <- pullCensus("group(B15003)", bay_area_counties) %>%
select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
gather(key = "variable", value = "estimate", -blockgroup) %>%
mutate(label = acs_vars$label[match(variable,acs_vars$name)]) %>%
select(-variable) %>%
separate(label, into = c(NA, NA, "education level"), sep = "!!") %>%
mutate(`education level` = replace_na(`education level`, "total_educ")) %>% # if the education level field is NA, this corresponded to the total number in that blockgroup
spread(key = `education level`, value = estimate) %>%
mutate(`percent associates or higher` = (`Associate's degree` + `Bachelor's degree` + `Doctorate degree` + `Master's degree`)*100/total_educ, `percent less than associates` = 100-`percent associates or higher`) %>%
left_join(bay_age_by_block %>% dplyr::select_if(!names(.) %in% c("elderly", "percent elderly", "less than 30", "percent less than 30"))) %>%
filter(!is.na(device_count))
# plotting
bay_education_by_block %>%
ggplot(aes(
x = `percent associates or higher`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of people with an degree at Associate's level or higher",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Education"
)
educ_model <- lm(`% Not Completely at Home` ~ `percent associates or higher`, bay_education_by_block)
summary(educ_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `percent associates or higher`,
## data = bay_education_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -27.184 -5.530 -0.760 4.744 43.548
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 60.723373 0.334942 181.29 <2e-16 ***
## `percent associates or higher` -0.141764 0.006168 -22.98 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.514 on 4733 degrees of freedom
## (8 observations deleted due to missingness)
## Multiple R-squared: 0.1004, Adjusted R-squared: 0.1002
## F-statistic: 528.2 on 1 and 4733 DF, p-value: < 2.2e-16
Compare to pre-shelter-in-place behavior:
bay_education_by_block %>%
ggplot(aes(
x = `percent associates or higher`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of people with an degree at Associate's level or higher",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and Education Pre Shelter-in-Place"
)
educ_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `percent associates or higher`, bay_education_by_block)
summary(educ_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `percent associates or higher`,
## data = bay_education_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.2636 -3.0081 0.4311 3.4893 15.3499
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 73.135228 0.202927 360.40 <2e-16 ***
## `percent associates or higher` 0.092690 0.003737 24.81 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.155 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.1151, Adjusted R-squared: 0.1149
## F-statistic: 615.3 on 1 and 4732 DF, p-value: < 2.2e-16
Motivated by this paper https://www.nber.org/papers/w26982.pdf on social distancing, internet access, and inequality, we look at whether a household has “Broadband (high-speed) Internet service such as cable, fiber optic, or DSL service,” and staying at home.
bay_internet_by_block <- pullCensus("group(B28002)", bay_area_counties) %>%
select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
gather(key = "variable", value = "estimate", -blockgroup) %>%
mutate(label = acs_vars$label[match(variable,acs_vars$name)]) %>%
select(-variable) %>%
separate(label, into = c(NA, NA, "subscription", "type", "additional"), sep = "!!") %>%
filter(is.na(subscription) | (type == "Broadband such as cable, fiber optic or DSL") & is.na(additional)) %>%
mutate(type = replace_na(type, "total_num")) %>%
dplyr::select(blockgroup, type, estimate) %>%
spread(key = type, value = estimate) %>%
mutate(`percent high speed` = `Broadband such as cable, fiber optic or DSL`*100/total_num, `percent no high speed` = 100-`percent high speed`) %>%
left_join(bay_age_by_block %>% dplyr::select_if(!names(.) %in% c("elderly", "percent elderly", "less than 30", "percent less than 30"))) %>%
filter(!is.na(device_count))
# plotting
bay_internet_by_block %>%
ggplot(aes(
x = `percent high speed`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of households with broadband such as cable, fiber optic or DSL",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and High Speed Internet"
)
internet_model <- lm(`% Not Completely at Home` ~ `percent high speed`, bay_internet_by_block)
summary(internet_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `percent high speed`,
## data = bay_internet_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -29.152 -5.569 -0.436 5.004 43.707
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 69.278040 0.737701 93.91 <2e-16 ***
## `percent high speed` -0.198061 0.009154 -21.64 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.528 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.0901, Adjusted R-squared: 0.0899
## F-statistic: 468.2 on 1 and 4728 DF, p-value: < 2.2e-16
Compare to pre-shelter-in-place behavior:
bay_internet_by_block %>%
ggplot(aes(
x = `percent high speed`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of households without broadband such as cable, fiber optic or DSL",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Staying at Home and High Speed Internet Pre Shelter-in-Place"
)
internet_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `percent high speed`, bay_internet_by_block)
summary(internet_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `percent high speed`,
## data = bay_internet_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -29.3893 -3.1107 0.1585 3.5344 20.8729
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 67.53971 0.44725 151.01 <2e-16 ***
## `percent high speed` 0.12937 0.00555 23.31 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.171 on 4728 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.1031, Adjusted R-squared: 0.1029
## F-statistic: 543.4 on 1 and 4728 DF, p-value: < 2.2e-16
bay_race_by_block <- pullCensus("group(B02001)", bay_area_counties) %>%
select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
gather(key = "variable", value = "estimate", -blockgroup) %>%
mutate(label = acs_vars$label[match(variable,acs_vars$name)]) %>%
select(-variable) %>%
separate(label, into = c(NA, NA, "race", "specification"), sep = "!!") %>%
filter(is.na(specification) & !is.na(race)) %>%
dplyr::select(blockgroup, estimate, race) %>%
spread(key = race, value = estimate) %>%
mutate(total_race = `American Indian and Alaska Native alone` + `Asian alone` + `Black or African American alone` + `Native Hawaiian and Other Pacific Islander alone` + `Some other race alone` + `Two or more races` + `White alone`, `% white` = `White alone`*100/total_race, `% Asian` = `Asian alone`*100/total_race, `% black` = `Black or African American alone`*100/total_race) %>%
left_join(bay_age_by_block %>% dplyr::select_if(!names(.) %in% c("elderly", "percent elderly", "less than 30", "percent less than 30"))) %>%
filter(!is.na(device_count))
# also get ethnicity data (hispanic/latino vs not)
bay_hisplat_by_block <- pullCensus("group(B03002)", bay_area_counties) %>%
select(-c(contains("EA"),contains("MA"),contains("M"))) %>%
gather(key = "variable", value = "estimate", -blockgroup) %>%
mutate(label = acs_vars$label[match(variable,acs_vars$name)]) %>%
select(-variable) %>%
separate(label, into = c(NA, NA, "hisp/lat", "specification"), sep = "!!") %>%
filter(is.na(specification) & !is.na(`hisp/lat`)) %>%
dplyr::select(blockgroup, estimate, `hisp/lat`) %>%
spread(key = `hisp/lat`, value = estimate) %>%
mutate(`% non hispanic/latino` = `Not Hispanic or Latino`*100/(`Hispanic or Latino` + `Not Hispanic or Latino`))
# join with the race data
bay_race_by_block <- bay_race_by_block %>% left_join(bay_hisplat_by_block %>% dplyr::select(blockgroup, `% non hispanic/latino`))
# plotting
# percent white
bay_race_by_block %>%
ggplot(aes(
x = `% white`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are white",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and White Residents"
)
white_model <- lm(`% Not Completely at Home` ~ `% white`, bay_race_by_block)
summary(white_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% white`, data = bay_race_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -26.756 -5.808 -0.274 5.405 40.487
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 49.126499 0.314033 156.44 <2e-16 ***
## `% white` 0.082606 0.005327 15.51 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.769 on 4734 degrees of freedom
## (7 observations deleted due to missingness)
## Multiple R-squared: 0.04833, Adjusted R-squared: 0.04813
## F-statistic: 240.4 on 1 and 4734 DF, p-value: < 2.2e-16
# percent Asian
bay_race_by_block %>%
ggplot(aes(
x = `% Asian`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are Asian",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Asian Residents"
)
asian_model <- lm(`% Not Completely at Home` ~ `% Asian`, bay_race_by_block)
summary(asian_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% Asian`, data = bay_race_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -27.733 -5.235 -0.583 4.657 42.945
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 58.193029 0.176671 329.39 <2e-16 ***
## `% Asian` -0.195125 0.005611 -34.77 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.023 on 4734 degrees of freedom
## (7 observations deleted due to missingness)
## Multiple R-squared: 0.2035, Adjusted R-squared: 0.2033
## F-statistic: 1209 on 1 and 4734 DF, p-value: < 2.2e-16
# percent non hispanic/latino
bay_race_by_block %>%
ggplot(aes(
x = `% non hispanic/latino`,
y = `% Not Completely at Home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are not Hispanic or Latino",
y = "Percent devices leaving home on weekdays since shelter-in-place",
title = "Bay Area: Social Distancing and Hispanic/Latino Residents"
)
hisp_model <- lm(`% Not Completely at Home` ~ `% non hispanic/latino`, bay_race_by_block)
summary(hisp_model)
##
## Call:
## lm(formula = `% Not Completely at Home` ~ `% non hispanic/latino`,
## data = bay_race_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -27.817 -5.637 -0.576 4.950 41.449
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 62.827282 0.517102 121.50 <2e-16 ***
## `% non hispanic/latino` -0.119133 0.006458 -18.45 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.683 on 4734 degrees of freedom
## (7 observations deleted due to missingness)
## Multiple R-squared: 0.06706, Adjusted R-squared: 0.06686
## F-statistic: 340.3 on 1 and 4734 DF, p-value: < 2.2e-16
Compare to pre-shelter-in-place behavior:
bay_race_by_block %>%
ggplot(aes(
x = `% white`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are white",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Social Distancing and White Residents Pre Shelter-in-Place"
)
white_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `% white`, bay_race_by_block)
summary(white_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% white`,
## data = bay_race_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.636 -3.187 0.365 3.610 14.301
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 74.825617 0.190483 392.82 <2e-16 ***
## `% white` 0.055451 0.003231 17.16 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.317 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.05859, Adjusted R-squared: 0.05839
## F-statistic: 294.5 on 1 and 4732 DF, p-value: < 2.2e-16
bay_race_by_block %>%
ggplot(aes(
x = `% Asian`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are Asian",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Social Distancing and Asian Residents Pre Shelter-in-Place"
)
asian_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `% Asian`, bay_race_by_block)
summary(asian_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% Asian`,
## data = bay_race_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -32.937 -3.425 0.249 3.755 14.494
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 77.600043 0.120661 643.127 <2e-16 ***
## `% Asian` 0.009013 0.003832 2.352 0.0187 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.477 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.001168, Adjusted R-squared: 0.0009568
## F-statistic: 5.533 on 1 and 4732 DF, p-value: 0.0187
bay_race_by_block %>%
ggplot(aes(
x = `% non hispanic/latino`,
y = `% Not Completely at Home Pre Shelter`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are not Hispanic or Latino",
y = "Percent devices leaving home on weekdays pre-shelter-in-place",
title = "Bay Area: Social Distancing and Hispanic/Latino Residents Pre Shelter-in-Place"
)
hisp_model2 <- lm(`% Not Completely at Home Pre Shelter` ~ `% non hispanic/latino`, bay_race_by_block)
summary(hisp_model2)
##
## Call:
## lm(formula = `% Not Completely at Home Pre Shelter` ~ `% non hispanic/latino`,
## data = bay_race_by_block)
##
## Residuals:
## Min 1Q Median 3Q Max
## -33.022 -3.189 0.459 3.605 17.674
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 72.007971 0.314583 228.90 <2e-16 ***
## `% non hispanic/latino` 0.074764 0.003929 19.03 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.282 on 4732 degrees of freedom
## (9 observations deleted due to missingness)
## Multiple R-squared: 0.07109, Adjusted R-squared: 0.07089
## F-statistic: 362.1 on 1 and 4732 DF, p-value: < 2.2e-16
Multiple regression analysis with income, education, and internet
# multiple regression
modeltest <- lm(bay_ami_by_block$`% Not Completely at Home` ~ bay_ami_by_block$`% over 125,000` + bay_education_by_block$`percent associates or higher` + bay_internet_by_block$`percent high speed`)
summary(modeltest)
##
## Call:
## lm(formula = bay_ami_by_block$`% Not Completely at Home` ~ bay_ami_by_block$`% over 125,000` +
## bay_education_by_block$`percent associates or higher` + bay_internet_by_block$`percent high speed`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -25.480 -5.428 -0.583 4.630 44.911
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 64.648674 0.756391
## bay_ami_by_block$`% over 125,000` -0.120948 0.008953
## bay_education_by_block$`percent associates or higher` -0.026757 0.008859
## bay_internet_by_block$`percent high speed` -0.063025 0.011528
## t value Pr(>|t|)
## (Intercept) 85.470 < 2e-16 ***
## bay_ami_by_block$`% over 125,000` -13.510 < 2e-16 ***
## bay_education_by_block$`percent associates or higher` -3.020 0.00254 **
## bay_internet_by_block$`percent high speed` -5.467 4.81e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.23 on 4726 degrees of freedom
## (13 observations deleted due to missingness)
## Multiple R-squared: 0.1529, Adjusted R-squared: 0.1524
## F-statistic: 284.4 on 3 and 4726 DF, p-value: < 2.2e-16
bay_dem_distancing <- bay_internet_by_block %>%
dplyr::select(`percent high speed`, `% Not Completely at Home`, `% Completely at Home`, blockgroup) %>%
left_join(bay_education_by_block %>% dplyr::select(blockgroup, `percent associates or higher`)) %>%
left_join(bay_ami_by_block %>% dplyr::select(blockgroup, `% over 125,000`)) %>%
left_join(bay_ami_by_block %>% dplyr::select(blockgroup, `% over 100,000`)) %>%
left_join(bay_ami_by_block %>% dplyr::select(blockgroup, `% over 75,000`)) %>%
left_join(bay_age_by_block %>% dplyr::select(blockgroup, `percent less than 30`)) %>%
left_join(bay_age_by_block %>% dplyr::select(blockgroup, `percent elderly`)) %>%
left_join(bay_lang_by_block %>% dplyr::select(blockgroup, `% not speaking spanish`)) %>%
left_join(bay_lang_by_block %>% dplyr::select(blockgroup, `% speaking english > well`)) %>%
left_join(bay_no_vehicles_by_block %>% dplyr::select(blockgroup, `percent with vehicles`)) %>%
left_join(bay_occupants_per_room_by_block %>% dplyr::select(blockgroup, `percent less than 1`)) %>%
left_join(bay_race_by_block %>% dplyr::select(blockgroup, `% white`, `% Asian`, `% non hispanic/latino`)) %>%
left_join(bay_age_by_block %>% dplyr::select(blockgroup, `percent less than 18`)) %>%
left_join(bay_age_by_block %>% dplyr::select(blockgroup, `percent 20-29`))
bay_dem_distancing_pre_post <- bay_dem_distancing %>%
left_join(bay_internet_by_block %>% dplyr::select(`% Not Completely at Home Pre Shelter`, `% Completely at Home Pre Shelter`, blockgroup)) %>%
mutate(`% increase in staying completely home` = `% Completely at Home` - `% Completely at Home Pre Shelter`, frac_increase = `% increase in staying completely home`/`% Completely at Home Pre Shelter`)
bay_dem_distancing[is.na(bay_dem_distancing)] <- 0
bay_dem_distancing_pre_post[is.na(bay_dem_distancing_pre_post)] <- 0
saveRDS(bay_dem_distancing_pre_post, "/Users/simonespeizer/Documents/2020 Spring Quarter/CEE 218Z/covid19/Simone_Speizer/bay_socialdistancing_demdata_prepostdifs_manyvars.rds")
# bay_dem_distancing_pre_post <- readRDS("/Users/simonespeizer/Documents/2020 Spring Quarter/CEE 218Z/covid19/Simone_Speizer/bay_socialdistancing_demdata_prepostdifs_manyvars.rds")
# age
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `percent less than 30`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents younger than 30",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Young Age Groups"
)
young_model_dif <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`percent less than 30`)
summary(young_model_dif)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`percent less than 30`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -58.943 -6.424 0.005 6.855 33.055
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 28.92319 0.54029 53.533
## bay_dem_distancing_pre_post$`percent less than 30` -0.13344 0.01463 -9.123
## Pr(>|t|)
## (Intercept) <2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 30` <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.62 on 4741 degrees of freedom
## Multiple R-squared: 0.01725, Adjusted R-squared: 0.01704
## F-statistic: 83.22 on 1 and 4741 DF, p-value: < 2.2e-16
young_model_frac <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`percent less than 30`)
summary(young_model_frac)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`percent less than 30`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2657 -0.4941 -0.1215 0.3793 3.9988
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 1.588540 0.037599 42.25
## bay_dem_distancing_pre_post$`percent less than 30` -0.010203 0.001018 -10.02
## Pr(>|t|)
## (Intercept) <2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 30` <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7392 on 4741 degrees of freedom
## Multiple R-squared: 0.02075, Adjusted R-squared: 0.02054
## F-statistic: 100.5 on 1 and 4741 DF, p-value: < 2.2e-16
bay_dem_distancing_pre_post %>% filter(`percent elderly` < 50) %>% # get rid of extreme outliers
ggplot(aes(
x = `percent elderly`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents 65 and older",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Elderly Population"
)
elderly_model_dif <- lm(`% increase in staying completely home` ~ `percent elderly`, bay_dem_distancing_pre_post %>% filter(`percent elderly` < 50))
summary(elderly_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `percent elderly`,
## data = bay_dem_distancing_pre_post %>% filter(`percent elderly` <
## 50))
##
## Residuals:
## Min 1Q Median 3Q Max
## -61.069 -6.626 -0.041 6.961 33.418
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 21.99372 0.32828 66.996 < 2e-16 ***
## `percent elderly` 0.14989 0.01897 7.902 3.4e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.62 on 4700 degrees of freedom
## Multiple R-squared: 0.01311, Adjusted R-squared: 0.0129
## F-statistic: 62.44 on 1 and 4700 DF, p-value: 3.401e-15
elderly_model_frac <- lm(frac_increase ~ `percent elderly`, bay_dem_distancing_pre_post %>% filter(`percent elderly` < 50))
summary(elderly_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `percent elderly`, data = bay_dem_distancing_pre_post %>%
## filter(`percent elderly` < 50))
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.0499 -0.5002 -0.1194 0.3741 3.9793
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.006917 0.022780 44.20 <2e-16 ***
## `percent elderly` 0.014802 0.001316 11.24 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.737 on 4700 degrees of freedom
## Multiple R-squared: 0.0262, Adjusted R-squared: 0.02599
## F-statistic: 126.4 on 1 and 4700 DF, p-value: < 2.2e-16
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `percent less than 18`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents younger than 18",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Child Population"
)
child_model_dif <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`percent less than 18`)
summary(child_model_dif)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`percent less than 18`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -57.351 -6.872 0.183 7.259 31.462
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 19.85106 0.41220 48.16
## bay_dem_distancing_pre_post$`percent less than 18` 0.21677 0.01907 11.37
## Pr(>|t|)
## (Intercept) <2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.57 on 4741 degrees of freedom
## Multiple R-squared: 0.02653, Adjusted R-squared: 0.02632
## F-statistic: 129.2 on 1 and 4741 DF, p-value: < 2.2e-16
child_model_frac <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`percent less than 18`)
summary(child_model_frac)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`percent less than 18`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5310 -0.5202 -0.0999 0.3960 3.9959
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 0.895641 0.028659 31.25
## bay_dem_distancing_pre_post$`percent less than 18` 0.016538 0.001326 12.47
## Pr(>|t|)
## (Intercept) <2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7351 on 4741 degrees of freedom
## Multiple R-squared: 0.03177, Adjusted R-squared: 0.03156
## F-statistic: 155.6 on 1 and 4741 DF, p-value: < 2.2e-16
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `percent 20-29`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents ages 20-29",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Young Adult Residents"
)
young_adult_model_dif <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`percent 20-29`)
summary(young_adult_model_dif)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`percent 20-29`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -55.305 -6.402 0.193 6.865 38.925
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 28.63144 0.28559 100.25
## bay_dem_distancing_pre_post$`percent 20-29` -0.33146 0.01816 -18.25
## Pr(>|t|)
## (Intercept) <2e-16 ***
## bay_dem_distancing_pre_post$`percent 20-29` <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.36 on 4741 degrees of freedom
## Multiple R-squared: 0.06568, Adjusted R-squared: 0.06548
## F-statistic: 333.3 on 1 and 4741 DF, p-value: < 2.2e-16
young_adult_model_frac <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`percent 20-29`)
summary(young_adult_model_frac)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`percent 20-29`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2742 -0.4762 -0.0915 0.3800 3.9302
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 1.596986 0.019606 81.45
## bay_dem_distancing_pre_post$`percent 20-29` -0.027642 0.001246 -22.18
## Pr(>|t|)
## (Intercept) <2e-16 ***
## bay_dem_distancing_pre_post$`percent 20-29` <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7111 on 4741 degrees of freedom
## Multiple R-squared: 0.09398, Adjusted R-squared: 0.09379
## F-statistic: 491.8 on 1 and 4741 DF, p-value: < 2.2e-16
# income - less than $75000
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `% over 75,000`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $75,000 (50% AMI) annually",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Households Above 50% AMI"
)
income_75_model_dif <- lm(`% increase in staying completely home` ~ `% over 75,000`, bay_dem_distancing_pre_post)
summary(income_75_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `% over 75,000`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -63.107 -5.198 0.477 5.941 33.250
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.841106 0.439548 17.84 <2e-16 ***
## `% over 75,000` 0.270610 0.006918 39.12 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.317 on 4741 degrees of freedom
## Multiple R-squared: 0.244, Adjusted R-squared: 0.2438
## F-statistic: 1530 on 1 and 4741 DF, p-value: < 2.2e-16
income_75_model_frac <- lm(frac_increase ~ `% over 75,000`, bay_dem_distancing_pre_post)
summary(income_75_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `% over 75,000`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2214 -0.3916 -0.0535 0.3252 3.7891
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0372825 0.0301996 1.235 0.217
## `% over 75,000` 0.0196873 0.0004753 41.418 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6401 on 4741 degrees of freedom
## Multiple R-squared: 0.2657, Adjusted R-squared: 0.2655
## F-statistic: 1715 on 1 and 4741 DF, p-value: < 2.2e-16
# income - less than $100000
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `% over 100,000`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $100,000 (80% AMI) annually",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Households Below 80% AMI"
)
income_100_model_dif <- lm(`% increase in staying completely home` ~ `% over 100,000`, bay_dem_distancing_pre_post)
summary(income_100_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `% over 100,000`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -63.505 -4.953 0.532 5.880 30.128
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.999003 0.338838 32.46 <2e-16 ***
## `% over 100,000` 0.269674 0.006371 42.33 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.128 on 4741 degrees of freedom
## Multiple R-squared: 0.2743, Adjusted R-squared: 0.2741
## F-statistic: 1792 on 1 and 4741 DF, p-value: < 2.2e-16
income_100_model_frac <- lm(frac_increase ~ `% over 100,000`, bay_dem_distancing_pre_post)
summary(income_100_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `% over 100,000`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.3238 -0.3689 -0.0328 0.3185 3.6991
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.2566983 0.0231141 11.11 <2e-16 ***
## `% over 100,000` 0.0198302 0.0004346 45.63 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6227 on 4741 degrees of freedom
## Multiple R-squared: 0.3052, Adjusted R-squared: 0.305
## F-statistic: 2082 on 1 and 4741 DF, p-value: < 2.2e-16
# income - less than $125000
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `% over 125,000`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with incomes over $125,000 annually",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Households Below $125,000"
)
income_125_model_dif <- lm(`% increase in staying completely home` ~ `% over 125,000`, bay_dem_distancing_pre_post)
summary(income_125_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `% over 125,000`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -66.353 -4.707 0.662 5.859 27.495
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 13.210195 0.281170 46.98 <2e-16 ***
## `% over 125,000` 0.280752 0.006357 44.17 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.019 on 4741 degrees of freedom
## Multiple R-squared: 0.2915, Adjusted R-squared: 0.2914
## F-statistic: 1951 on 1 and 4741 DF, p-value: < 2.2e-16
income_125_model_frac <- lm(frac_increase ~ `% over 125,000`, bay_dem_distancing_pre_post)
summary(income_125_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `% over 125,000`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5463 -0.3529 -0.0299 0.3202 3.6688
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.4096837 0.0190321 21.53 <2e-16 ***
## `% over 125,000` 0.0208903 0.0004303 48.55 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6105 on 4741 degrees of freedom
## Multiple R-squared: 0.3321, Adjusted R-squared: 0.332
## F-statistic: 2357 on 1 and 4741 DF, p-value: < 2.2e-16
# language
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `% speaking english > well`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of individuals speaking English well",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and English Language Ability"
)
english_ability_model_dif <- lm(`% increase in staying completely home` ~ `% speaking english > well`, bay_dem_distancing_pre_post)
summary(english_ability_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `% speaking english > well`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -57.924 -6.518 0.135 6.957 32.920
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.00262 1.54502 3.885 0.000104 ***
## `% speaking english > well` 0.19740 0.01668 11.836 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.56 on 4741 degrees of freedom
## Multiple R-squared: 0.0287, Adjusted R-squared: 0.0285
## F-statistic: 140.1 on 1 and 4741 DF, p-value: < 2.2e-16
english_ability_model_frac <- lm(frac_increase ~ `% speaking english > well`, bay_dem_distancing_pre_post)
summary(english_ability_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `% speaking english > well`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.1540 -0.4823 -0.0964 0.3732 3.9587
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.567857 0.106103 -5.352 9.11e-08 ***
## `% speaking english > well` 0.019475 0.001145 17.004 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7252 on 4741 degrees of freedom
## Multiple R-squared: 0.05748, Adjusted R-squared: 0.05728
## F-statistic: 289.1 on 1 and 4741 DF, p-value: < 2.2e-16
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `% not speaking spanish`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of individuals not speaking Spanish",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Spanish Language Ability"
)
spanish_speaking_model_dif <- lm(`% increase in staying completely home` ~ `% not speaking spanish`, bay_dem_distancing_pre_post)
summary(spanish_speaking_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `% not speaking spanish`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -63.486 -5.815 0.671 6.575 29.580
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.786948 0.704050 9.64 <2e-16 ***
## `% not speaking spanish` 0.207614 0.008212 25.28 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.06 on 4741 degrees of freedom
## Multiple R-squared: 0.1188, Adjusted R-squared: 0.1186
## F-statistic: 639.2 on 1 and 4741 DF, p-value: < 2.2e-16
spanish_speaking_model_frac <- lm(frac_increase ~ `% not speaking spanish`, bay_dem_distancing_pre_post)
summary(spanish_speaking_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `% not speaking spanish`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.1334 -0.4446 -0.0571 0.3544 3.8584
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0664614 0.0486305 -1.367 0.172
## `% not speaking spanish` 0.0154268 0.0005672 27.197 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6948 on 4741 degrees of freedom
## Multiple R-squared: 0.135, Adjusted R-squared: 0.1348
## F-statistic: 739.7 on 1 and 4741 DF, p-value: < 2.2e-16
# occupants per room
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `percent less than 1`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of households with 1 or fewer occupant per room",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Room Occupancy"
)
occupants_model_dif <- lm(`% increase in staying completely home` ~ `percent less than 1`, bay_dem_distancing_pre_post)
summary(occupants_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `percent less than 1`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -62.986 -6.394 0.249 6.793 33.192
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.34571 1.43730 0.241 0.81
## `percent less than 1` 0.25640 0.01536 16.689 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.41 on 4741 degrees of freedom
## Multiple R-squared: 0.05549, Adjusted R-squared: 0.05529
## F-statistic: 278.5 on 1 and 4741 DF, p-value: < 2.2e-16
occupants_model_frac <- lm(frac_increase ~ `percent less than 1`, bay_dem_distancing_pre_post)
summary(occupants_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `percent less than 1`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.0903 -0.4844 -0.0931 0.3765 3.8806
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.70208 0.09918 -7.079 1.66e-12 ***
## `percent less than 1` 0.02074 0.00106 19.563 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7186 on 4741 degrees of freedom
## Multiple R-squared: 0.0747, Adjusted R-squared: 0.0745
## F-statistic: 382.7 on 1 and 4741 DF, p-value: < 2.2e-16
# vehicles - percent with no vehicles
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `percent with vehicles`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of housholds with vehicles available",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Vehicle Availability"
)
vehicles_model_dif <- lm(`% increase in staying completely home` ~ `percent with vehicles`, bay_dem_distancing_pre_post)
summary(vehicles_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `percent with vehicles`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -62.720 -6.620 0.012 7.080 31.380
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.20415 1.04747 7.832 5.87e-15 ***
## `percent with vehicles` 0.17516 0.01135 15.433 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.46 on 4741 degrees of freedom
## Multiple R-squared: 0.04784, Adjusted R-squared: 0.04764
## F-statistic: 238.2 on 1 and 4741 DF, p-value: < 2.2e-16
vehicles_model_frac <- lm(frac_increase ~ `percent with vehicles`, bay_dem_distancing_pre_post)
summary(vehicles_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `percent with vehicles`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.0690 -0.4971 -0.1096 0.3759 3.9661
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0685642 0.0723782 -0.947 0.344
## `percent with vehicles` 0.0141914 0.0007842 18.096 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7225 on 4741 degrees of freedom
## Multiple R-squared: 0.06461, Adjusted R-squared: 0.06441
## F-statistic: 327.5 on 1 and 4741 DF, p-value: < 2.2e-16
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `percent associates or higher`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of people with an degree at Associate's level or higher",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Education"
)
educ_model_dif <- lm(`% increase in staying completely home` ~ `percent associates or higher`, bay_dem_distancing_pre_post)
summary(educ_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `percent associates or higher`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -66.217 -5.112 0.902 6.228 26.234
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 12.240229 0.374878 32.65 <2e-16 ***
## `percent associates or higher` 0.237396 0.006909 34.36 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.588 on 4741 degrees of freedom
## Multiple R-squared: 0.1994, Adjusted R-squared: 0.1992
## F-statistic: 1181 on 1 and 4741 DF, p-value: < 2.2e-16
educ_model_frac <- lm(frac_increase ~ `percent associates or higher`, bay_dem_distancing_pre_post)
summary(educ_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `percent associates or higher`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.3224 -0.3783 -0.0346 0.3409 3.5256
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.3298148 0.0256120 12.88 <2e-16 ***
## `percent associates or higher` 0.0178170 0.0004721 37.74 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6551 on 4741 degrees of freedom
## Multiple R-squared: 0.2311, Adjusted R-squared: 0.2309
## F-statistic: 1425 on 1 and 4741 DF, p-value: < 2.2e-16
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `percent high speed`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of households with broadband such as cable, fiber optic or DSL",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and High Speed Internet"
)
internet_model_dif <- lm(`% increase in staying completely home` ~ `percent high speed`, bay_dem_distancing_pre_post)
summary(internet_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `percent high speed`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -61.454 -5.644 0.365 6.246 37.341
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.832438 0.797146 -2.299 0.0216 *
## `percent high speed` 0.328581 0.009905 33.173 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.653 on 4741 degrees of freedom
## Multiple R-squared: 0.1884, Adjusted R-squared: 0.1882
## F-statistic: 1100 on 1 and 4741 DF, p-value: < 2.2e-16
internet_model_frac <- lm(frac_increase ~ `percent high speed`, bay_dem_distancing_pre_post)
summary(internet_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `percent high speed`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.3723 -0.4295 -0.0927 0.3348 3.7444
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.5276772 0.0559890 -9.425 <2e-16 ***
## `percent high speed` 0.0221528 0.0006957 31.843 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.678 on 4741 degrees of freedom
## Multiple R-squared: 0.1762, Adjusted R-squared: 0.176
## F-statistic: 1014 on 1 and 4741 DF, p-value: < 2.2e-16
# white
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `% white`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are white",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and White Residents"
)
white_model_dif <- lm(`% increase in staying completely home` ~ `% white`, bay_dem_distancing_pre_post)
summary(white_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `% white`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -60.224 -6.849 -0.068 7.103 32.020
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 25.449922 0.381489 66.712 < 2e-16 ***
## `% white` -0.023245 0.006476 -3.589 0.000335 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.7 on 4741 degrees of freedom
## Multiple R-squared: 0.00271, Adjusted R-squared: 0.0025
## F-statistic: 12.88 on 1 and 4741 DF, p-value: 0.000335
white_model_frac <- lm(frac_increase ~ `% white`, bay_dem_distancing_pre_post)
summary(white_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `% white`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.0940 -0.5074 -0.1190 0.3926 4.0869
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.0566327 0.0264927 39.884 < 2e-16 ***
## `% white` 0.0031738 0.0004498 7.057 1.95e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7431 on 4741 degrees of freedom
## Multiple R-squared: 0.01039, Adjusted R-squared: 0.01019
## F-statistic: 49.8 on 1 and 4741 DF, p-value: 1.953e-12
# asian
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `% Asian`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are Asian",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Asian Residents"
)
asian_model_dif <- lm(`% increase in staying completely home` ~ `% Asian`, bay_dem_distancing_pre_post)
summary(asian_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `% Asian`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -56.403 -5.930 0.005 6.516 30.859
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 19.338483 0.215982 89.54 <2e-16 ***
## `% Asian` 0.205779 0.006865 29.98 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.825 on 4741 degrees of freedom
## Multiple R-squared: 0.1593, Adjusted R-squared: 0.1591
## F-statistic: 898.5 on 1 and 4741 DF, p-value: < 2.2e-16
asian_model_frac <- lm(frac_increase ~ `% Asian`, bay_dem_distancing_pre_post)
summary(asian_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `% Asian`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2912 -0.4843 -0.1484 0.3709 4.1052
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.0084129 0.0158665 63.56 <2e-16 ***
## `% Asian` 0.0092693 0.0005043 18.38 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7218 on 4741 degrees of freedom
## Multiple R-squared: 0.06652, Adjusted R-squared: 0.06632
## F-statistic: 337.8 on 1 and 4741 DF, p-value: < 2.2e-16
# hispanic/latino
bay_dem_distancing_pre_post %>%
ggplot(aes(
x = `% non hispanic/latino`,
y = `% increase in staying completely home`
)) + geom_point() +
geom_smooth(method=lm) +
labs(
x = "Percent of residents that are not Hispanic or Latino",
y = "Dif in % completely at home after shelter-in-place relative to before",
title = "Bay Area: Social Distancing and Hispanic/Latino Residents"
)
hisp_model_dif <- lm(`% increase in staying completely home` ~ `% non hispanic/latino`, bay_dem_distancing_pre_post)
summary(hisp_model_dif)
##
## Call:
## lm(formula = `% increase in staying completely home` ~ `% non hispanic/latino`,
## data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -64.040 -5.747 0.638 6.641 29.054
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.895479 0.587172 15.15 <2e-16 ***
## `% non hispanic/latino` 0.197388 0.007339 26.90 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.981 on 4741 degrees of freedom
## Multiple R-squared: 0.1324, Adjusted R-squared: 0.1322
## F-statistic: 723.4 on 1 and 4741 DF, p-value: < 2.2e-16
hisp_model_frac <- lm(frac_increase ~ `% non hispanic/latino`, bay_dem_distancing_pre_post)
summary(hisp_model_frac)
##
## Call:
## lm(formula = frac_increase ~ `% non hispanic/latino`, data = bay_dem_distancing_pre_post)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.1580 -0.4356 -0.0529 0.3604 3.7867
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0842276 0.0404697 2.081 0.0375 *
## `% non hispanic/latino` 0.0147441 0.0005058 29.149 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6879 on 4741 degrees of freedom
## Multiple R-squared: 0.152, Adjusted R-squared: 0.1518
## F-statistic: 849.7 on 1 and 4741 DF, p-value: < 2.2e-16
difs_model_inc_span <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% not speaking spanish`)
summary(difs_model_inc_span)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% not speaking spanish`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -66.465 -4.727 0.688 5.830 27.382
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 10.236332 0.637468
## bay_dem_distancing_pre_post$`% over 125,000` 0.259645 0.007530
## bay_dem_distancing_pre_post$`% not speaking spanish` 0.045309 0.008722
## t value Pr(>|t|)
## (Intercept) 16.058 < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 34.483 < 2e-16 ***
## bay_dem_distancing_pre_post$`% not speaking spanish` 5.195 2.14e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.995 on 4740 degrees of freedom
## Multiple R-squared: 0.2955, Adjusted R-squared: 0.2952
## F-statistic: 994.2 on 2 and 4740 DF, p-value: < 2.2e-16
frac_model_inc_span <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% not speaking spanish`)
summary(frac_model_inc_span)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% not speaking spanish`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4714 -0.3522 -0.0253 0.3181 3.6414
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 0.1903893 0.0431266
## bay_dem_distancing_pre_post$`% over 125,000` 0.0193338 0.0005094
## bay_dem_distancing_pre_post$`% not speaking spanish` 0.0033411 0.0005901
## t value Pr(>|t|)
## (Intercept) 4.415 1.03e-05 ***
## bay_dem_distancing_pre_post$`% over 125,000` 37.954 < 2e-16 ***
## bay_dem_distancing_pre_post$`% not speaking spanish` 5.662 1.58e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6085 on 4740 degrees of freedom
## Multiple R-squared: 0.3366, Adjusted R-squared: 0.3363
## F-statistic: 1202 on 2 and 4740 DF, p-value: < 2.2e-16
difs_model_inc_span_educ <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% not speaking spanish` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(difs_model_inc_span_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% not speaking spanish` +
## bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -66.827 -4.512 0.784 5.808 26.527
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 10.73268 0.64468
## bay_dem_distancing_pre_post$`% over 125,000` 0.23491 0.00916
## bay_dem_distancing_pre_post$`% not speaking spanish` 0.01974 0.01025
## bay_dem_distancing_pre_post$`percent associates or higher` 0.05193 0.01100
## t value Pr(>|t|)
## (Intercept) 16.648 < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 25.645 < 2e-16 ***
## bay_dem_distancing_pre_post$`% not speaking spanish` 1.926 0.0542 .
## bay_dem_distancing_pre_post$`percent associates or higher` 4.720 2.43e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.975 on 4739 degrees of freedom
## Multiple R-squared: 0.2988, Adjusted R-squared: 0.2984
## F-statistic: 673.2 on 3 and 4739 DF, p-value: < 2.2e-16
frac_model_inc_span_educ <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% not speaking spanish` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(frac_model_inc_span_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% not speaking spanish` + bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4975 -0.3488 -0.0186 0.3136 3.5814
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 0.2317750 0.0435610
## bay_dem_distancing_pre_post$`% over 125,000` 0.0172713 0.0006190
## bay_dem_distancing_pre_post$`% not speaking spanish` 0.0012094 0.0006926
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0043301 0.0007434
## t value Pr(>|t|)
## (Intercept) 5.321 1.08e-07 ***
## bay_dem_distancing_pre_post$`% over 125,000` 27.904 < 2e-16 ***
## bay_dem_distancing_pre_post$`% not speaking spanish` 1.746 0.0809 .
## bay_dem_distancing_pre_post$`percent associates or higher` 5.824 6.11e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6064 on 4739 degrees of freedom
## Multiple R-squared: 0.3413, Adjusted R-squared: 0.3409
## F-statistic: 818.5 on 3 and 4739 DF, p-value: < 2.2e-16
The effect of Spanish language speaking vanishes when accounting for both education and income.
difs_model_inc_eng_educ <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% speaking english > well` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(difs_model_inc_eng_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% speaking english > well` +
## bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -70.522 -4.328 0.873 5.687 25.848
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 24.959746 1.383953
## bay_dem_distancing_pre_post$`% over 125,000` 0.244092 0.009082
## bay_dem_distancing_pre_post$`% speaking english > well` -0.165913 0.016854
## bay_dem_distancing_pre_post$`percent associates or higher` 0.098844 0.009937
## t value Pr(>|t|)
## (Intercept) 18.035 <2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 26.875 <2e-16 ***
## bay_dem_distancing_pre_post$`% speaking english > well` -9.844 <2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 9.948 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.888 on 4739 degrees of freedom
## Multiple R-squared: 0.3123, Adjusted R-squared: 0.3119
## F-statistic: 717.5 on 3 and 4739 DF, p-value: < 2.2e-16
frac_model_inc_eng_educ <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% speaking english > well` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(frac_model_inc_eng_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% speaking english > well` +
## bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5450 -0.3448 -0.0135 0.3161 3.5823
##
## Coefficients:
## Estimate
## (Intercept) 0.7462848
## bay_dem_distancing_pre_post$`% over 125,000` 0.0176203
## bay_dem_distancing_pre_post$`% speaking english > well` -0.0056714
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0062369
## Std. Error t value
## (Intercept) 0.0942164 7.921
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006183 28.498
## bay_dem_distancing_pre_post$`% speaking english > well` 0.0011474 -4.943
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006765 9.220
## Pr(>|t|)
## (Intercept) 2.91e-15 ***
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`% speaking english > well` 7.96e-07 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6051 on 4739 degrees of freedom
## Multiple R-squared: 0.3443, Adjusted R-squared: 0.3438
## F-statistic: 829.3 on 3 and 4739 DF, p-value: < 2.2e-16
difs_model_lots <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% speaking english > well` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`% not speaking spanish` + bay_dem_distancing_pre_post$`percent with vehicles`)
summary(difs_model_lots)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% speaking english > well` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`% not speaking spanish` +
## bay_dem_distancing_pre_post$`percent with vehicles`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -73.494 -4.310 0.828 5.515 25.908
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 18.798366 1.453769
## bay_dem_distancing_pre_post$`% over 125,000` 0.206123 0.009496
## bay_dem_distancing_pre_post$`% speaking english > well` -0.272710 0.018780
## bay_dem_distancing_pre_post$`percent associates or higher` 0.099056 0.011133
## bay_dem_distancing_pre_post$`% not speaking spanish` 0.075914 0.010674
## bay_dem_distancing_pre_post$`percent with vehicles` 0.121714 0.010856
## t value Pr(>|t|)
## (Intercept) 12.931 < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 21.705 < 2e-16 ***
## bay_dem_distancing_pre_post$`% speaking english > well` -14.521 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 8.898 < 2e-16 ***
## bay_dem_distancing_pre_post$`% not speaking spanish` 7.112 1.32e-12 ***
## bay_dem_distancing_pre_post$`percent with vehicles` 11.212 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.747 on 4737 degrees of freedom
## Multiple R-squared: 0.3342, Adjusted R-squared: 0.3335
## F-statistic: 475.6 on 5 and 4737 DF, p-value: < 2.2e-16
frac_model_lots <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% speaking english > well` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`% not speaking spanish` + bay_dem_distancing_pre_post$`percent with vehicles`)
summary(frac_model_lots)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% speaking english > well` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`% not speaking spanish` + bay_dem_distancing_pre_post$`percent with vehicles`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.6950 -0.3449 -0.0203 0.3086 3.5203
##
## Coefficients:
## Estimate
## (Intercept) 0.3163669
## bay_dem_distancing_pre_post$`% over 125,000` 0.0149339
## bay_dem_distancing_pre_post$`% speaking english > well` -0.0125433
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0069854
## bay_dem_distancing_pre_post$`% not speaking spanish` 0.0038793
## bay_dem_distancing_pre_post$`percent with vehicles` 0.0088204
## Std. Error t value
## (Intercept) 0.0989750 3.196
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006465 23.099
## bay_dem_distancing_pre_post$`% speaking english > well` 0.0012786 -9.810
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0007579 9.217
## bay_dem_distancing_pre_post$`% not speaking spanish` 0.0007267 5.338
## bay_dem_distancing_pre_post$`percent with vehicles` 0.0007391 11.934
## Pr(>|t|)
## (Intercept) 0.0014 **
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`% speaking english > well` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## bay_dem_distancing_pre_post$`% not speaking spanish` 9.83e-08 ***
## bay_dem_distancing_pre_post$`percent with vehicles` < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5955 on 4737 degrees of freedom
## Multiple R-squared: 0.3651, Adjusted R-squared: 0.3644
## F-statistic: 544.7 on 5 and 4737 DF, p-value: < 2.2e-16
difs_model_inc_hisp_educ <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% non hispanic/latino` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(difs_model_inc_hisp_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% non hispanic/latino` +
## bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -66.843 -4.546 0.752 5.793 26.633
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 10.560060 0.532467
## bay_dem_distancing_pre_post$`% over 125,000` 0.234645 0.009145
## bay_dem_distancing_pre_post$`% non hispanic/latino` 0.029385 0.009691
## bay_dem_distancing_pre_post$`percent associates or higher` 0.043205 0.011416
## t value Pr(>|t|)
## (Intercept) 19.832 < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 25.659 < 2e-16 ***
## bay_dem_distancing_pre_post$`% non hispanic/latino` 3.032 0.002442 **
## bay_dem_distancing_pre_post$`percent associates or higher` 3.785 0.000156 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.969 on 4739 degrees of freedom
## Multiple R-squared: 0.2996, Adjusted R-squared: 0.2992
## F-statistic: 675.8 on 3 and 4739 DF, p-value: < 2.2e-16
frac_model_inc_hisp_educ <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% non hispanic/latino` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(frac_model_inc_hisp_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% non hispanic/latino` + bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4802 -0.3490 -0.0163 0.3181 3.5845
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 0.2097901 0.0359732
## bay_dem_distancing_pre_post$`% over 125,000` 0.0172406 0.0006178
## bay_dem_distancing_pre_post$`% non hispanic/latino` 0.0020764 0.0006547
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0036082 0.0007713
## t value Pr(>|t|)
## (Intercept) 5.832 5.85e-09 ***
## bay_dem_distancing_pre_post$`% over 125,000` 27.906 < 2e-16 ***
## bay_dem_distancing_pre_post$`% non hispanic/latino` 3.171 0.00153 **
## bay_dem_distancing_pre_post$`percent associates or higher` 4.678 2.97e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.606 on 4739 degrees of freedom
## Multiple R-squared: 0.3423, Adjusted R-squared: 0.3418
## F-statistic: 822 on 3 and 4739 DF, p-value: < 2.2e-16
difs_model_inc_white_educ <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% white` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(difs_model_inc_white_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% white` +
## bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -63.428 -4.350 0.881 5.579 25.210
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 15.306684 0.390359
## bay_dem_distancing_pre_post$`% over 125,000` 0.242626 0.008837
## bay_dem_distancing_pre_post$`% white` -0.101650 0.005537
## bay_dem_distancing_pre_post$`percent associates or higher` 0.096559 0.009211
## t value Pr(>|t|)
## (Intercept) 39.21 <2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 27.45 <2e-16 ***
## bay_dem_distancing_pre_post$`% white` -18.36 <2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 10.48 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.675 on 4739 degrees of freedom
## Multiple R-squared: 0.3449, Adjusted R-squared: 0.3445
## F-statistic: 831.5 on 3 and 4739 DF, p-value: < 2.2e-16
frac_model_inc_white_educ <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% white` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(frac_model_inc_white_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% white` + bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5704 -0.3489 -0.0235 0.3175 3.5137
##
## Coefficients:
## Estimate
## (Intercept) 0.3702557
## bay_dem_distancing_pre_post$`% over 125,000` 0.0174865
## bay_dem_distancing_pre_post$`% white` -0.0021496
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0057229
## Std. Error t value
## (Intercept) 0.0272078 13.608
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006160 28.389
## bay_dem_distancing_pre_post$`% white` 0.0003859 -5.570
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006420 8.914
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`% white` 2.69e-08 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6046 on 4739 degrees of freedom
## Multiple R-squared: 0.3452, Adjusted R-squared: 0.3447
## F-statistic: 832.6 on 3 and 4739 DF, p-value: < 2.2e-16
difs_model_inc_asian_educ <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(difs_model_inc_asian_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -62.615 -4.177 0.768 5.367 25.547
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 9.940784 0.339685
## bay_dem_distancing_pre_post$`% over 125,000` 0.213721 0.008663
## bay_dem_distancing_pre_post$`% Asian` 0.148516 0.006084
## bay_dem_distancing_pre_post$`percent associates or higher` 0.047341 0.008831
## t value Pr(>|t|)
## (Intercept) 29.265 < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 24.672 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 24.412 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 5.361 8.68e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.462 on 4739 degrees of freedom
## Multiple R-squared: 0.3767, Adjusted R-squared: 0.3763
## F-statistic: 954.5 on 3 and 4739 DF, p-value: < 2.2e-16
frac_model_inc_asian_educ <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher`)
summary(frac_model_inc_asian_educ)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5370 -0.3447 -0.0230 0.3083 3.4180
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 0.2383122 0.0240592
## bay_dem_distancing_pre_post$`% over 125,000` 0.0166486 0.0006135
## bay_dem_distancing_pre_post$`% Asian` 0.0046374 0.0004309
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0045230 0.0006255
## t value Pr(>|t|)
## (Intercept) 9.905 < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 27.135 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 10.762 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 7.231 5.55e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5993 on 4739 degrees of freedom
## Multiple R-squared: 0.3566, Adjusted R-squared: 0.3562
## F-statistic: 875.5 on 3 and 4739 DF, p-value: < 2.2e-16
difs_model_inc_asian_educ_eng <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`% speaking english > well`)
summary(difs_model_inc_asian_educ_eng)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`% speaking english > well`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -62.282 -4.168 0.773 5.359 25.554
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 8.930573 1.503757
## bay_dem_distancing_pre_post$`% over 125,000` 0.212813 0.008762
## bay_dem_distancing_pre_post$`% Asian` 0.150623 0.006808
## bay_dem_distancing_pre_post$`percent associates or higher` 0.044452 0.009775
## bay_dem_distancing_pre_post$`% speaking english > well` 0.012384 0.017957
## t value Pr(>|t|)
## (Intercept) 5.939 3.08e-09 ***
## bay_dem_distancing_pre_post$`% over 125,000` 24.287 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 22.124 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 4.547 5.57e-06 ***
## bay_dem_distancing_pre_post$`% speaking english > well` 0.690 0.49
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.462 on 4738 degrees of freedom
## Multiple R-squared: 0.3767, Adjusted R-squared: 0.3762
## F-statistic: 715.9 on 4 and 4738 DF, p-value: < 2.2e-16
frac_model_inc_asian_educ_eng <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`% speaking english > well`)
summary(frac_model_inc_asian_educ_eng)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`% speaking english > well`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5378 -0.3443 -0.0222 0.3083 3.4195
##
## Coefficients:
## Estimate
## (Intercept) 0.2568982
## bay_dem_distancing_pre_post$`% over 125,000` 0.0166653
## bay_dem_distancing_pre_post$`% Asian` 0.0045987
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0045762
## bay_dem_distancing_pre_post$`% speaking english > well` -0.0002278
## Std. Error t value
## (Intercept) 0.1065129 2.412
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006207 26.851
## bay_dem_distancing_pre_post$`% Asian` 0.0004822 9.536
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006924 6.609
## bay_dem_distancing_pre_post$`% speaking english > well` 0.0012719 -0.179
## Pr(>|t|)
## (Intercept) 0.0159 *
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 4.29e-11 ***
## bay_dem_distancing_pre_post$`% speaking english > well` 0.8578
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5994 on 4738 degrees of freedom
## Multiple R-squared: 0.3566, Adjusted R-squared: 0.3561
## F-statistic: 656.5 on 4 and 4738 DF, p-value: < 2.2e-16
difs_model_inc_asian_educ_internet <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent high speed`)
summary(difs_model_inc_asian_educ_internet)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent high speed`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -61.969 -4.196 0.701 5.317 24.681
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 4.797571 0.733885
## bay_dem_distancing_pre_post$`% over 125,000` 0.189501 0.009138
## bay_dem_distancing_pre_post$`% Asian` 0.144325 0.006068
## bay_dem_distancing_pre_post$`percent associates or higher` 0.029843 0.009050
## bay_dem_distancing_pre_post$`percent high speed` 0.089262 0.011310
## t value Pr(>|t|)
## (Intercept) 6.537 6.93e-11 ***
## bay_dem_distancing_pre_post$`% over 125,000` 20.738 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 23.785 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 3.297 0.000983 ***
## bay_dem_distancing_pre_post$`percent high speed` 7.892 3.66e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.408 on 4738 degrees of freedom
## Multiple R-squared: 0.3847, Adjusted R-squared: 0.3842
## F-statistic: 740.7 on 4 and 4738 DF, p-value: < 2.2e-16
frac_model_inc_asian_educ_internet <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent high speed`)
summary(frac_model_inc_asian_educ_internet)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent high speed`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4532 -0.3451 -0.0265 0.3010 3.4069
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 0.0284793 0.0522074
## bay_dem_distancing_pre_post$`% over 125,000` 0.0156605 0.0006500
## bay_dem_distancing_pre_post$`% Asian` 0.0044665 0.0004317
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0038091 0.0006438
## bay_dem_distancing_pre_post$`percent high speed` 0.0036417 0.0008046
## t value Pr(>|t|)
## (Intercept) 0.546 0.585
## bay_dem_distancing_pre_post$`% over 125,000` 24.091 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 10.347 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 5.916 3.52e-09 ***
## bay_dem_distancing_pre_post$`percent high speed` 4.526 6.15e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5981 on 4738 degrees of freedom
## Multiple R-squared: 0.3594, Adjusted R-squared: 0.3588
## F-statistic: 664.4 on 4 and 4738 DF, p-value: < 2.2e-16
difs_model_inc_asian_educ_vehicle <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent with vehicles`)
summary(difs_model_inc_asian_educ_vehicle)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent with vehicles`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -63.033 -4.266 0.743 5.414 26.471
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 2.113709 0.924419
## bay_dem_distancing_pre_post$`% over 125,000` 0.185154 0.009146
## bay_dem_distancing_pre_post$`% Asian` 0.153931 0.006061
## bay_dem_distancing_pre_post$`percent associates or higher` 0.061546 0.008894
## bay_dem_distancing_pre_post$`percent with vehicles` 0.088719 0.009758
## t value Pr(>|t|)
## (Intercept) 2.287 0.0223 *
## bay_dem_distancing_pre_post$`% over 125,000` 20.245 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 25.396 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 6.920 5.12e-12 ***
## bay_dem_distancing_pre_post$`percent with vehicles` 9.092 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.39 on 4738 degrees of freedom
## Multiple R-squared: 0.3874, Adjusted R-squared: 0.3868
## F-statistic: 748.9 on 4 and 4738 DF, p-value: < 2.2e-16
frac_model_inc_asian_educ_vehicle <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent with vehicles`)
summary(frac_model_inc_asian_educ_vehicle)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent with vehicles`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5103 -0.3449 -0.0296 0.3028 3.3752
##
## Coefficients:
## Estimate
## (Intercept) -0.3768715
## bay_dem_distancing_pre_post$`% over 125,000` 0.0144033
## bay_dem_distancing_pre_post$`% Asian` 0.0050630
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0056395
## bay_dem_distancing_pre_post$`percent with vehicles` 0.0069731
## Std. Error t value
## (Intercept) 0.0653423 -5.768
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006464 22.281
## bay_dem_distancing_pre_post$`% Asian` 0.0004284 11.817
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006287 8.970
## bay_dem_distancing_pre_post$`percent with vehicles` 0.0006897 10.110
## Pr(>|t|)
## (Intercept) 8.55e-09 ***
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent with vehicles` < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.593 on 4738 degrees of freedom
## Multiple R-squared: 0.3702, Adjusted R-squared: 0.3696
## F-statistic: 696.2 on 4 and 4738 DF, p-value: < 2.2e-16
difs_model_inc_asian_educ_vehicle <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent with vehicles` + bay_dem_distancing_pre_post$`percent high speed`)
summary(difs_model_inc_asian_educ_vehicle)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent with vehicles` +
## bay_dem_distancing_pre_post$`percent high speed`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -62.522 -4.177 0.704 5.339 27.981
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 0.518614 0.982306
## bay_dem_distancing_pre_post$`% over 125,000` 0.175803 0.009338
## bay_dem_distancing_pre_post$`% Asian` 0.150015 0.006104
## bay_dem_distancing_pre_post$`percent associates or higher` 0.047059 0.009390
## bay_dem_distancing_pre_post$`percent with vehicles` 0.069034 0.010592
## bay_dem_distancing_pre_post$`percent high speed` 0.057824 0.012250
## t value Pr(>|t|)
## (Intercept) 0.528 0.598
## bay_dem_distancing_pre_post$`% over 125,000` 18.827 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 24.575 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 5.012 5.59e-07 ***
## bay_dem_distancing_pre_post$`percent with vehicles` 6.518 7.88e-11 ***
## bay_dem_distancing_pre_post$`percent high speed` 4.720 2.42e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.371 on 4737 degrees of freedom
## Multiple R-squared: 0.3902, Adjusted R-squared: 0.3896
## F-statistic: 606.3 on 5 and 4737 DF, p-value: < 2.2e-16
frac_model_inc_asian_educ_vehicle <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent with vehicles` + bay_dem_distancing_pre_post$`percent high speed`)
summary(frac_model_inc_asian_educ_vehicle)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent with vehicles` + bay_dem_distancing_pre_post$`percent high speed`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4984 -0.3455 -0.0311 0.3024 3.3757
##
## Coefficients:
## Estimate
## (Intercept) -0.3920916
## bay_dem_distancing_pre_post$`% over 125,000` 0.0143141
## bay_dem_distancing_pre_post$`% Asian` 0.0050257
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0055012
## bay_dem_distancing_pre_post$`percent with vehicles` 0.0067852
## bay_dem_distancing_pre_post$`percent high speed` 0.0005517
## Std. Error t value
## (Intercept) 0.0695942 -5.634
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006616 21.637
## bay_dem_distancing_pre_post$`% Asian` 0.0004325 11.621
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006653 8.269
## bay_dem_distancing_pre_post$`percent with vehicles` 0.0007504 9.042
## bay_dem_distancing_pre_post$`percent high speed` 0.0008679 0.636
## Pr(>|t|)
## (Intercept) 1.86e-08 ***
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent with vehicles` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent high speed` 0.525
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5931 on 4737 degrees of freedom
## Multiple R-squared: 0.3702, Adjusted R-squared: 0.3696
## F-statistic: 557 on 5 and 4737 DF, p-value: < 2.2e-16
This model seems to capture the most variation so far, though it is only an improvement of about 1% of the variation predicted than the previous one with solely income, education, and Asian residents.
difs_model_inc_educ_child_asian <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian` )
summary(difs_model_inc_educ_child_asian)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent less than 18` +
## bay_dem_distancing_pre_post$`% Asian`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -57.943 -4.160 0.718 5.271 27.824
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 3.456668 0.494425
## bay_dem_distancing_pre_post$`% over 125,000` 0.176887 0.008652
## bay_dem_distancing_pre_post$`percent associates or higher` 0.093489 0.008951
## bay_dem_distancing_pre_post$`percent less than 18` 0.272741 0.015518
## bay_dem_distancing_pre_post$`% Asian` 0.154024 0.005904
## t value Pr(>|t|)
## (Intercept) 6.991 3.1e-12 ***
## bay_dem_distancing_pre_post$`% over 125,000` 20.445 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 10.444 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` 17.575 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 26.090 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.2 on 4738 degrees of freedom
## Multiple R-squared: 0.4148, Adjusted R-squared: 0.4143
## F-statistic: 839.6 on 4 and 4738 DF, p-value: < 2.2e-16
frac_model_inc_educ_child_asian <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian` )
summary(frac_model_inc_educ_child_asian)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4472 -0.3335 -0.0322 0.2954 3.3258
##
## Coefficients:
## Estimate
## (Intercept) -0.2377859
## bay_dem_distancing_pre_post$`% over 125,000` 0.0139441
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0079114
## bay_dem_distancing_pre_post$`percent less than 18` 0.0200261
## bay_dem_distancing_pre_post$`% Asian` 0.0050419
## Std. Error t value
## (Intercept) 0.0349337 -6.807
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006113 22.811
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006324 12.509
## bay_dem_distancing_pre_post$`percent less than 18` 0.0010965 18.264
## bay_dem_distancing_pre_post$`% Asian` 0.0004171 12.087
## Pr(>|t|)
## (Intercept) 1.12e-11 ***
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5793 on 4738 degrees of freedom
## Multiple R-squared: 0.3989, Adjusted R-squared: 0.3984
## F-statistic: 786.1 on 4 and 4738 DF, p-value: < 2.2e-16
difs_model_inc_educ_asian_yad <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent 20-29` + bay_dem_distancing_pre_post$`% Asian` )
summary(difs_model_inc_educ_asian_yad)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent 20-29` + bay_dem_distancing_pre_post$`% Asian`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -58.744 -4.201 0.790 5.460 28.057
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 12.956681 0.418765
## bay_dem_distancing_pre_post$`% over 125,000` 0.179825 0.008992
## bay_dem_distancing_pre_post$`percent associates or higher` 0.059702 0.008762
## bay_dem_distancing_pre_post$`percent 20-29` -0.186866 0.015595
## bay_dem_distancing_pre_post$`% Asian` 0.156425 0.006030
## t value Pr(>|t|)
## (Intercept) 30.940 < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 19.999 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 6.814 1.07e-11 ***
## bay_dem_distancing_pre_post$`percent 20-29` -11.983 < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` 25.939 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.337 on 4738 degrees of freedom
## Multiple R-squared: 0.395, Adjusted R-squared: 0.3945
## F-statistic: 773.3 on 4 and 4738 DF, p-value: < 2.2e-16
frac_model_inc_educ_asian_yad <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian` )
summary(frac_model_inc_educ_asian_yad)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4472 -0.3335 -0.0322 0.2954 3.3258
##
## Coefficients:
## Estimate
## (Intercept) -0.2377859
## bay_dem_distancing_pre_post$`% over 125,000` 0.0139441
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0079114
## bay_dem_distancing_pre_post$`percent less than 18` 0.0200261
## bay_dem_distancing_pre_post$`% Asian` 0.0050419
## Std. Error t value
## (Intercept) 0.0349337 -6.807
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006113 22.811
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006324 12.509
## bay_dem_distancing_pre_post$`percent less than 18` 0.0010965 18.264
## bay_dem_distancing_pre_post$`% Asian` 0.0004171 12.087
## Pr(>|t|)
## (Intercept) 1.12e-11 ***
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5793 on 4738 degrees of freedom
## Multiple R-squared: 0.3989, Adjusted R-squared: 0.3984
## F-statistic: 786.1 on 4 and 4738 DF, p-value: < 2.2e-16
difs_model_inc_educ_asian_yad_child <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent 20-29` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent less than 18`)
summary(difs_model_inc_educ_asian_yad_child)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent 20-29` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent less than 18`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -57.630 -4.173 0.670 5.289 27.785
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 6.193338 0.615209
## bay_dem_distancing_pre_post$`% over 125,000` 0.160201 0.008894
## bay_dem_distancing_pre_post$`percent associates or higher` 0.095378 0.008904
## bay_dem_distancing_pre_post$`percent 20-29` -0.118034 0.015951
## bay_dem_distancing_pre_post$`% Asian` 0.158313 0.005899
## bay_dem_distancing_pre_post$`percent less than 18` 0.237759 0.016139
## t value Pr(>|t|)
## (Intercept) 10.07 < 2e-16 ***
## bay_dem_distancing_pre_post$`% over 125,000` 18.01 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 10.71 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent 20-29` -7.40 1.6e-13 ***
## bay_dem_distancing_pre_post$`% Asian` 26.84 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` 14.73 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.154 on 4737 degrees of freedom
## Multiple R-squared: 0.4215, Adjusted R-squared: 0.4209
## F-statistic: 690.3 on 5 and 4737 DF, p-value: < 2.2e-16
frac_model_inc_educ_asian_yad_child <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent less than 18`)
summary(frac_model_inc_educ_asian_yad_child)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent less than 18`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4472 -0.3335 -0.0322 0.2954 3.3258
##
## Coefficients:
## Estimate
## (Intercept) -0.2377859
## bay_dem_distancing_pre_post$`% over 125,000` 0.0139441
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0079114
## bay_dem_distancing_pre_post$`percent less than 18` 0.0200261
## bay_dem_distancing_pre_post$`% Asian` 0.0050419
## Std. Error t value
## (Intercept) 0.0349337 -6.807
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006113 22.811
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006324 12.509
## bay_dem_distancing_pre_post$`percent less than 18` 0.0010965 18.264
## bay_dem_distancing_pre_post$`% Asian` 0.0004171 12.087
## Pr(>|t|)
## (Intercept) 1.12e-11 ***
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5793 on 4738 degrees of freedom
## Multiple R-squared: 0.3989, Adjusted R-squared: 0.3984
## F-statistic: 786.1 on 4 and 4738 DF, p-value: < 2.2e-16
difs_model_inc_educ_asian_yad_child_internet <- lm(bay_dem_distancing_pre_post$`% increase in staying completely home` ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`percent 20-29` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent high speed`)
summary(difs_model_inc_educ_asian_yad_child_internet)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$`% increase in staying completely home` ~
## bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent less than 18` +
## bay_dem_distancing_pre_post$`percent 20-29` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent high speed`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -55.638 -4.153 0.688 5.249 27.366
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 2.354277 0.834499
## bay_dem_distancing_pre_post$`% over 125,000` 0.140469 0.009319
## bay_dem_distancing_pre_post$`percent associates or higher` 0.078889 0.009191
## bay_dem_distancing_pre_post$`percent less than 18` 0.223710 0.016197
## bay_dem_distancing_pre_post$`percent 20-29` -0.125720 0.015916
## bay_dem_distancing_pre_post$`% Asian` 0.154854 0.005893
## bay_dem_distancing_pre_post$`percent high speed` 0.074577 0.011014
## t value Pr(>|t|)
## (Intercept) 2.821 0.0048 **
## bay_dem_distancing_pre_post$`% over 125,000` 15.073 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` 8.583 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` 13.812 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent 20-29` -7.899 3.47e-15 ***
## bay_dem_distancing_pre_post$`% Asian` 26.276 < 2e-16 ***
## bay_dem_distancing_pre_post$`percent high speed` 6.771 1.43e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.115 on 4736 degrees of freedom
## Multiple R-squared: 0.427, Adjusted R-squared: 0.4263
## F-statistic: 588.3 on 6 and 4736 DF, p-value: < 2.2e-16
frac_model_inc_educ_asian_yad_child_internet <- lm(bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` + bay_dem_distancing_pre_post$`percent associates or higher` + bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian` + bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`percent high speed`)
summary(frac_model_inc_educ_asian_yad_child_internet)
##
## Call:
## lm(formula = bay_dem_distancing_pre_post$frac_increase ~ bay_dem_distancing_pre_post$`% over 125,000` +
## bay_dem_distancing_pre_post$`percent associates or higher` +
## bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`% Asian` +
## bay_dem_distancing_pre_post$`percent less than 18` + bay_dem_distancing_pre_post$`percent high speed`)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4740 -0.3336 -0.0345 0.2949 3.3307
##
## Coefficients:
## Estimate
## (Intercept) -0.3493357
## bay_dem_distancing_pre_post$`% over 125,000` 0.0134263
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0074502
## bay_dem_distancing_pre_post$`percent less than 18` 0.0196992
## bay_dem_distancing_pre_post$`% Asian` 0.0049381
## bay_dem_distancing_pre_post$`percent high speed` 0.0020708
## Std. Error t value
## (Intercept) 0.0547851 -6.376
## bay_dem_distancing_pre_post$`% over 125,000` 0.0006416 20.927
## bay_dem_distancing_pre_post$`percent associates or higher` 0.0006557 11.362
## bay_dem_distancing_pre_post$`percent less than 18` 0.0011027 17.864
## bay_dem_distancing_pre_post$`% Asian` 0.0004187 11.794
## bay_dem_distancing_pre_post$`percent high speed` 0.0007838 2.642
## Pr(>|t|)
## (Intercept) 1.98e-10 ***
## bay_dem_distancing_pre_post$`% over 125,000` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent associates or higher` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent less than 18` < 2e-16 ***
## bay_dem_distancing_pre_post$`% Asian` < 2e-16 ***
## bay_dem_distancing_pre_post$`percent high speed` 0.00827 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.579 on 4737 degrees of freedom
## Multiple R-squared: 0.3998, Adjusted R-squared: 0.3992
## F-statistic: 631.1 on 5 and 4737 DF, p-value: < 2.2e-16
This model seems to be the best. Including the age variables led to an increase in about 3% of the variability predicted.